#
# Common functions for the Validate routines of the Linux Counter
#
package Validate::Common;

use Validate::Places;
use Counter::Cache;

require Exporter;

@ISA = qw(Exporter);

@EXPORT = qw(mapsynonym email2country cleancountry);

# Control chattiness
$chatty = 1; # 0=No stderr output

sub initsynonyms {
    open(SYN, getfilename("data/synonyms"));
    while (<SYN>) {
	chop;
	next if /^\s*#/;
	next if /^\s*$/;
	($field, $right, $wrong) = split(":");
	if ($right eq "\@STRICT") {
	    $strict{$field} = 1;
	    $lhs{$field} = 1;
	} elsif ($right eq "\@LHS") {
	    $lhs{$field} = 1;
	} elsif (defined($wrong)) {
	    $wrong =~ tr/A-Z/a-z/;
	    $wrong =~ s/\s+$//; # trailing blanks found some places
	    $map{$field}{$wrong} = $right;
	    if ($lhs{$field}) { # All LHS are valid
		$wrong = $right;
		$wrong =~ tr/A-Z/a-z/;
		$map{$field}{$wrong} = $right;
	    }
	}
    }
    $syninited = 1;
}

sub mapsynonym {
    my($field, $inval) = @_;

    initsynonyms() if !$syninited;
    return "" if !defined($inval);
    ($match = $inval) =~ tr/A-Z/a-z/;
    if ($map{$field}{$match}) {
	return $map{$field}{$match};
    } elsif ($strict{$field}) {
	return ""; # this will cause a carp higher up
    } else {
	return $inval; # No synonym found
    }
}


sub loaddomainmap {
    my $filename = shift;
    open(DOMAINS, $filename) 
	|| die "loaddomainmap: Unable to open $filename\n";
    while (<DOMAINS>) {
	next if /^#/;
	if (/(\S+):/) {
	    $todom = $1;
	    $todom =~ tr/a-z/A-Z/;
	    ($low = $todom) =~ tr/A-Z/a-z/;
	    $mapsto{$low} = $todom;
	    @fromdom = split(/\s+/, $'); # '
	    for $fromdom (@fromdom) {
		next if !$fromdom;
		$mapsto{$fromdom} = $todom;
		@comps = split(/\./, $fromdom);
		$built = "";
		for $super (reverse @comps) {
		    $hassub{$built} = 1;
		    $built = $built?"$super.$built":$super;
		}
	    }
	}
    }
    close DOMAINS;
}

sub loaddomain2country {
    if (!$domain2countryloaded) {
	loaddomainmap(getfilename("data/domain2country"));
	$domain2countryloaded = 1;
    }
}

sub email2country {
    my $address = shift;
    my($domain, $country, $comp, @comps, $built, $relay);

    loaddomain2country;
    # Take a domain name, return country code
    # Uses a database
    $domain = $address;
    $domain =~ s/.*<(.+)>.*/$1/;
    $domain =~ s/^.*@([^@]+)$/$1/;
    $domain =~ tr/A-Z/a-z/;
    $domain =~ s/\(.*\)//;
    $domain =~ s/\s+$//;
    @comps = split(/\./, $domain);
    $built = "";
    $country = "ZZ"; # UNKNOWN place
    if (length($comps[$#comps]) eq 2) {
	$country = $comps[$#comps];
	$country =~ tr/a-z/A-Z/;
    }
    
    for $comp (reverse @comps) {
	$built = $built?"$comp.$built":$comp;
	$country = $mapsto{$built} if $mapsto{$built};
	# DEBUG
	warn "$current: *E* $built maps to EMPTY\n" if !$country && $chatty;
	last if !$hassub{$built};
    }
    if ($country eq "ZZ") {
	if ($address =~ /^@([^:,]+).*:/) {
	    $relay = $1;
	    # Source route via relay - try the relay part
	    # warn "$current: Failed on $built, trying $relay\n";
	    $country = &domain2country("x@$relay");
	} else {
	    warn "$current: Unable to map $address\n" if $chatty;
	    $country = "XW";
	}
    }
    if ($country eq "ZZ" || $country =~ /X./) {
	++ $strangedomains{$country, $domain};
    }
    $country;
}

sub cleancountry {
    my $arg = shift;
    if (!$cleancountrycache) {
	$cleancountrycache = Counter::Cache->new(\&_cleancountry, 600);
    }
    return $cleancountrycache->get($arg);
}

sub _cleancountry {
    my $value = shift;
    # Prefer to clean the country through the places database
    if (!defined($value) || $value eq '') {
	return ""; # empty is empty!
    }
    my $synvalue = mapsynonym("country", $value);
    my $rec = Validate::Places::getbyname($value);
    my $placevalue;
    if (!$rec) {
	warn "$current: $value not found in places\n" if $chatty;
	# quickfix - there are MANY in the "fieldstory" application
	$placevalue = $synvalue;
    } else {
	$placevalue = $rec->{name};
    }
    if ($placevalue ne $synvalue) {
	warn "$current: Unequal maps of $value: places \"$placevalue\" synonym \"$synvalue\"\n" if $chatty;
    }
    $value = $placevalue;
    # Max length 2 uppercase chars
    $value =~ tr/a-z/A-Z/;
    if (length($value) ne 2) {
	$value = ""; # Will get noted as strange, and Email taken.
    }
    $value;
}
    
sub getfilename {
    my $cand = shift;
    if (-f $cand) {
	return $cand;
    } else {
	return $ENV{COUNTER_ROOT} . "/" . $cand;
    }
}
